unit LazaMemo;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, StdCtrls;

type
  TCaretPosChangeEvent = procedure (Sender: TObject; const ARow, ACol: Longint) of object;
  // TScrollEvent defined in 'StdCtrls.pas'
  // TScrollEvent = procedure (Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer) of object;

  TLazaMemo = class(TMemo)
  private
//    FCol: Longint;
//    FRow: Longint;
    FOnCaretPosChange: TCaretPosChangeEvent;
    FOnHScroll: TScrollEvent;
    FOnVScroll: TScrollEvent;
    procedure SetOnHScroll(const Value: TScrollEvent);
    procedure SetOnVScroll(const Value: TScrollEvent);
    function GetLength(ARow: Longint): Longint;
    function GetCol(): Longint;
    function GetRow(): Longint;
    procedure SetCol(const Value: Longint);
    procedure SetRow(const Value: Longint);
    procedure SetOnCaretPosChange(const Value: TCaretPosChangeEvent);
    { Private declarations }
    procedure WMKeyUp(var Msg: TWMKeyUp); message WM_KEYUP;
    procedure WMLButtonUp(var Msg: TWMLButtonUp); message WM_LBUTTONUP;
    procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL;
    procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
  protected
    { Protected declarations }
    procedure HScroll(ScrollCode: TScrollCode; var ScrollPos: Integer); dynamic;
    procedure VScroll(ScrollCode: TScrollCode; var ScrollPos: Integer); dynamic;
    procedure CaretPosChange(const Pos: TPoint); dynamic;
    function GetCaretPos: TPoint; override;
    procedure SetCaretPos(const Value: TPoint); override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    procedure MoveCaretTo(ARow, ACol: Longint); virtual;
  public
    property Row: Longint read GetRow write SetRow;  // Used in run-time
    property Col: Longint read GetCol write SetCol;  // Used in run-time
    property CaretPos: TPoint read GetCaretPos write SetCaretPos;  // Used in run-time
    property Length[ARow: Longint]: Longint read GetLength;  // Used in run-time and read-only
  published
    { Published declarations }
    property OnCaretPosChange: TCaretPosChangeEvent read FOnCaretPosChange write SetOnCaretPosChange;
    property OnHScroll: TScrollEvent read FOnHScroll write SetOnHScroll;
    property OnVScroll: TScrollEvent read FOnVScroll write SetOnVScroll;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('LazaControls', [TLazaMemo]);
end;

{ TLazaMemo }

constructor TLazaMemo.Create(AOwner: TComponent);
begin
  inherited;
  if ([csDesigning, csLoading] * ComponentState = []) then
  begin
    // Insert code here if they is called in run-time.
  end;
  Self.WordWrap := False;
  Self.ScrollBars := ssBoth;
end;

procedure TLazaMemo.CaretPosChange(const Pos: TPoint);
begin
  if Assigned(FOnCaretPosChange) then FOnCaretPosChange(Self, Pos.Y, Pos.X);
end;

function TLazaMemo.GetCaretPos: TPoint;
begin
  Result := inherited GetCaretPos();
end;

function TLazaMemo.GetLength(ARow: Longint): Longint;
begin
  Result := Self.Perform(EM_LINELENGTH, Self.Perform(EM_LINEINDEX, ARow, 0), 0);
end;

function TLazaMemo.GetCol(): Longint;
begin
  Result := CaretPos.X;
//  Result := Self.SelStart - Self.Perform(EM_RowINDEX, -1, 0);
end;

function TLazaMemo.GetRow(): Longint;
begin
  Result := CaretPos.Y;
//  Result := Self.Perform(EM_RowFROMCHAR, -1, 0);
end;

procedure TLazaMemo.MoveCaretTo(ARow, ACol: Longint);
begin
  SetCaretPos(Classes.Point(ACol, ARow));
end;

procedure TLazaMemo.SetCaretPos(const Value: TPoint);
begin
  inherited;
  if (Value.X <> CaretPos.X) or (Value.Y <> CaretPos.Y) then
  begin
    CaretPosChange(Value);
  end;
end;

procedure TLazaMemo.SetCol(const Value: Longint);
begin
  SetCaretPos(Classes.Point(Value, CaretPos.Y));
end;

procedure TLazaMemo.SetOnCaretPosChange(const Value: TCaretPosChangeEvent);
begin
  FOnCaretPosChange := Value;
end;

procedure TLazaMemo.SetRow(const Value: Longint);
begin
  SetCaretPos(Classes.Point(CaretPos.X, Value));
end;

procedure TLazaMemo.WMKeyUp(var Msg: TWMKeyUp);
begin
  inherited;
  CaretPosChange(CaretPos);
end;

procedure TLazaMemo.WMLButtonUp(var Msg: TWMLButtonUp);
begin
  inherited;
  CaretPosChange(CaretPos);
end;

procedure TLazaMemo.SetOnHScroll(const Value: TScrollEvent);
begin
  FOnHScroll := Value;
end;

procedure TLazaMemo.SetOnVScroll(const Value: TScrollEvent);
begin
  FOnVScroll := Value;
end;

procedure TLazaMemo.HScroll(ScrollCode: TScrollCode; var ScrollPos: Integer);
begin
  if Assigned(FOnHScroll) then FOnHScroll(Self, ScrollCode, ScrollPos);
end;

procedure TLazaMemo.VScroll(ScrollCode: TScrollCode; var ScrollPos: Integer);
begin
  if Assigned(FOnVScroll) then FOnVScroll(Self, ScrollCode, ScrollPos);
end;

procedure TLazaMemo.WMHScroll(var Msg: TWMHScroll);
var
  ScrollPos: Integer;
begin
  inherited;
  ScrollPos := Msg.Pos;
  HScroll(TScrollCode(Msg.ScrollCode), ScrollPos);
  Msg.Pos := ScrollPos;
end;

procedure TLazaMemo.WMVScroll(var Msg: TWMVScroll);
var
  ScrollPos: Integer;
begin
  inherited;
  ScrollPos := Msg.Pos;
  VScroll(TScrollCode(Msg.ScrollCode), ScrollPos);
  Msg.Pos := ScrollPos;
end;

end.

